home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Amiga Format CD 52
/
Amiga Format AFCD52 (Issue 136, May 2000).iso
/
-serious-
/
programming
/
basic
/
mildred
/
lha
/
mscreen.lha
/
MildredScreen.ascii
< prev
next >
Wrap
Text File
|
1999-03-07
|
9KB
|
283 lines
WBStartup
DEFTYPE.w
MCPU Processor
Mc2pCPUmode Processor
*ScrVP._ViewPort=0
IsAGA.b=False
Dim PlanarBuf.l(2) ; Base address of planar memory to output c2p to (allowed up to triple buffers)
PrefDisplayID.l=$0 ; Default ModeID
PrefDisplayWidth.w=320 ; Default Width
PrefDisplayHeight.w=240 ; Default Height
PrefDisplayBuffering.b=3 ; 1..3. 1=Singlebuffered, 2=Doublebuffered, 3=Triplebuffered
SMRMinX=320 ; Minimum width
SMRMinY=240 ; Minimum height
SMRMaxX=640 ; Maximum width
SMRMaxY=480 ; Maximum height
;Either include SMR.bb2, or set PrefDisplayID, Width and Height to valid numbers (read from a prefs file?)
INCLUDE "SMR.bb2"
Function.b InitDisplay{Title$}
;Creates a display for AGA or Graphics-Card output
;Title$=The screen title (not displayed)
SHARED PrefDisplayWidth.w,PrefDisplayHeight.w,PrefDisplayBuffering.b
SHARED *ScrVP._ViewPort,PrefDisplayID.l,IsAGA.b,PlanarBuf()
;Open a test screen first to a) test for AGA or GFX-Card, and b) because the dimensions might be
;too large to open a chipram screen, and the dimensions for AGA have not yet been reduced to within limits
Dim ScrTags.TagItem(13)
Rect.Rectangle\MinX=0,0,320,240 ; For test
ScrTags(0)\ti_Tag=#SA_Width,320 ; For test
ScrTags(1)\ti_Tag=#SA_Height,240; For test
ScrTags(2)\ti_Tag=#SA_Depth,8
ScrTags(3)\ti_Tag=#SA_DisplayID,PrefDisplayID
ScrTags(4)\ti_Tag=#SA_Type,$F
ScrTags(5)\ti_Tag=#SA_Quiet,True
ScrTags(6)\ti_Tag=#SA_ShowTitle,False
ScrTags(7)\ti_Tag=#SA_Behind,True
ScrTags(8)\ti_Tag=#SA_DClip,&Rect ; For test
ScrTags(9)\ti_Tag=#SA_Exclusive,False
ScrTags(10)\ti_Tag=#SA_Draggable,True
ScrTags(11)\ti_Tag=#SA_AutoScroll,False
ScrTags(12)\ti_Tag=#TAG_DONE,0
ScrTags(13)\ti_Tag=#TAG_DONE,0
UsedChip.l=((320 LSR 3)*240)*8 ; With test params (depth 8)
FreeChip.l=AvailMem_(#MEMF_CHIP)
Forbid_
If ScreenTags(0,Title$,&ScrTags(0))<>0 ; Test for GFX-Card or AGA
NowChip.l=AvailMem_(#MEMF_CHIP)
Permit_
If FreeChip-NowChip<UsedChip
; Graphics card screen
IsAGA=False
PrefDisplayWidth AND $FFF0 ; For gfx-cards, width to nearest 16
ScrTags(0)\ti_Tag=#SA_Width,PrefDisplayWidth
Rect.Rectangle\MinX=0,0,PrefDisplayWidth,PrefDisplayHeight
ScrTags(1)\ti_Tag=#SA_Height,PrefDisplayHeight*PrefDisplayBuffering
ScrTags(8)\ti_Tag=#SA_DClip,&Rect
VWait 5 ; seems to be necessary (safer)
Free Screen 0
VWait 5
If ScreenTags(0,Title$,&ScrTags(0))<>0
For Loop.w=0 To PrefDisplayBuffering-1
If Loop=0 Then WFlags.l=$1900 Else WFlags.l=$800
If Window(Loop,0,PrefDisplayHeight*Loop,PrefDisplayWidth,PrefDisplayHeight,WFlags,"",0,0)=0 Then Function Return False
Menus Off
ScreensBitMap 0,Loop
*TmpBmp.bitmap=Addr BitMap(Loop)
Offset.l=*TmpBmp\_ebwidth*(PrefDisplayHeight*Loop)
For DLoop.w=0 To 8-1 ; Depth of 8
*TmpBmp\_data[DLoop]=*TmpBmp\_data[DLoop]+Offset
Next DLoop
Next Loop
Else
Function Return False
EndIf
Else
; AGA screen
IsAGA=True
PrefDisplayWidth AND $FFC0 ; For AGA, width to nearest 64
ScrTags(0)\ti_Tag=#SA_Width,PrefDisplayWidth
Rect.Rectangle\MinX=0,0,PrefDisplayWidth,PrefDisplayHeight
ScrTags(1)\ti_Tag=#SA_Height,PrefDisplayHeight ; Seperate buffers
ScrTags(8)\ti_Tag=#SA_DClip,&Rect
ScrTags(3)\ti_Tag=#SA_DisplayID,PrefDisplayID
Forbid_
VWait 5 ; seems to be necessary (safer)
Free Screen 0
VWait 5
For Loop.w=0 To PrefDisplayBuffering-1
If Loop=0 Then WFlags.l=$1900 Else WFlags.l=$800
If AvailMem_(#MEMF_CHIP)>=(PrefDisplayWidth*PrefDisplayHeight)+16
Memory.l=AllocMem((PrefDisplayWidth*PrefDisplayHeight)+16,$10002) ; Chip bitmap
Memory=(Memory+16) AND $FFFFFFF0 ; Align for move16's
If Memory<>0
CludgeBitMap Loop,PrefDisplayWidth,PrefDisplayHeight,8,Memory ; Depth 8
If Loop=0
ScrTags(12)\ti_Tag=#SA_BitMap,Addr BitMap(0)
If ScreenTags(0,Title$,&ScrTags(0))=0
Permit_
Function Return False
EndIf
EndIf
If Window(Loop,0,0,PrefDisplayWidth,PrefDisplayHeight,WFlags,"",0,0)=0 Then Function Return False
Menus Off
Else
Permit_
Function Return False
EndIf
Else
Permit_
Function Return False
EndIf
PlanarBuf(Loop)=Memory
Next Loop
Permit_
EndIf
DEFTYPE.DimensionInfo DimInfoBuf
GetDisplayInfoData_ FindDisplayInfo_(PrefDisplayID) AND $FFFFFFFF,&DimInfoBuf,SizeOf.DimensionInfo,#DTAG_DIMS,0
PrefDisplayLeft.w=((DimInfoBuf\TxtOScan\MaxX)-PrefDisplayWidth)/2
PrefDisplayTop.w=((DimInfoBuf\TxtOScan\MaxY)-PrefDisplayHeight)/2
*Scr._Screen=Peek.l(Addr Screen(0))
*ScrVP=ViewPort(0)
*ScrVP\DxOffset=PrefDisplayLeft,PrefDisplayTop
ScrollVPort_ *ScrVP
RethinkDisplay_
Menus Off
If *ScrVP\DHeight<>PrefDisplayHeight
Forbid_
*Scr\Height=PrefDisplayHeight ; Enforce y clipping
Permit_
EndIf
ScreenToFront_ *Scr
Function Return True
Else
Permit_
Function Return False
EndIf
End Function
.Main
;**** NOT NECESSARY ****
Pic$="5Ms.IFF"
#Objects=1
#UnQ=-1 ; Wether or not to unqueue the objects
InitBank 0,PrefDisplayWidth*PrefDisplayHeight,$10000
CludgeBitMap 0,PrefDisplayWidth,PrefDisplayHeight,8,Bank(0)
InitPalette 0,256
LoadBitMap 0,Pic$,0
;Make a chunky shape
If MShape(0,64,64)=0 Then End
MPlanar16ToShape 0,Bank(0),64,64,PrefDisplayWidth,PrefDisplayHeight
MMakeCookie 0
;Make other shapes
s=1
For y=0 To 32 Step 32
For x=0 To 32 Step 32
If MShape(s,32,32)=0 Then End
MPlanar16ToShape s,Bank(0)+((PrefDisplayWidth/8)*y)+(x/8)+(64/8),32,32,PrefDisplayWidth,PrefDisplayHeight
MMakeCookie s
s+1
Next x
Next y
Free Bank 0
.Table
;Set up movement table for moving objects
Dim x.w(#Objects)
Dim y.w(#Objects)
Dim xdirection.b(#Objects)
Dim ydirection.b(#Objects)
Dim xdirectionswap.b(#Objects)
Dim ydirectionswap.b(#Objects)
For obj=1 To #Objects
x(obj)=Rnd(PrefDisplayWidth-48)+16
y(obj)=Rnd(PrefDisplayHeight-48)+16
Repeat
xdirection(obj)=Rnd(8)-4
Until xdirection(obj)<>0
Repeat
ydirection(obj)=Rnd(8)-4
Until ydirection(obj)<>0
xdirectionswap(obj)=-xdirection(obj)
ydirectionswap(obj)=-ydirection(obj)
Next obj
;**** not necessary ****
.Prepare
;**** NECESSARY ****
If InitDisplay{"Game"}=False Then Goto Finish
ShowPalette 0
*RP._RastPort=RastPort(0)
Mc2pWindow 0,PrefDisplayWidth,PrefDisplayHeight ; Need this line in some form or other
MCludgeBitmap 4,PrefDisplayWidth,PrefDisplayHeight*PrefDisplayBuffering,*RP\_BitMap\Planes
;**** necessary ****
;Make some chunky buffers for source and background store
If MBitmap(1,PrefDisplayWidth,PrefDisplayHeight)=0 Then End
MAutoStencil On
If MBitmap(0,PrefDisplayWidth,PrefDisplayHeight)=0 Then End
;Draw background pattern
MUseShape 0
MClsStencil 0
For yy=0 To PrefDisplayHeight-64 Step 64
For xx=0 To PrefDisplayWidth-64 Step 64
MSBlock xx,yy
Next xx
Next yy
MUseBitmap 1
MBlockScroll 0,0,PrefDisplayWidth,PrefDisplayHeight,0,0,0
MUseBitmap 0
;Init queue and set blit mode for `put behind'
MQSBlitCut On
MSBlitCut On
MQueue 0,#Objects
.Loop
buf.b=0
its.l=0
cnt.b=0
ResetTimer
While Joyb(0)=0 AND Joyb(1)=0
For obj=1 To #Objects
;Move
x(obj)+xdirection(obj)
If x(obj)<4 OR x(obj)>PrefDisplayWidth-36 Then Exchange xdirection(obj),xdirectionswap(obj)
y(obj)+ydirection(obj)
If y(obj)<4 OR y(obj)>PrefDisplayHeight-36 Then Exchange ydirection(obj),ydirectionswap(obj)
;Try changing this to a different type of blit. If it's not a Q-type blit, comment-out the unqueue line also
MQSBlit (obj MOD 4)+1,x(obj),y(obj) ; Stencil-cut blit and add to queue
Next obj
;Display
;**** NECESSARY ****
If IsAGA
Mc2p MBitmapPtr(0),PlanarBuf(buf)
ShowBitMap buf
If PrefDisplayBuffering>1
buf+1
If buf=PrefDisplayBuffering Then buf=0
EndIf
Else
MUseBitmap 4
If PrefDisplayBuffering>1
MBlockScroll 0,0,PrefDisplayWidth,PrefDisplayHeight,0,PrefDisplayHeight+(cnt*PrefDisplayHeight),0
Else
MBlockScroll 0,0,PrefDisplayWidth,PrefDisplayHeight,0,0,0
EndIf
MUseBitmap 0
*RP0._RastPort=RastPort(0)
*RP1._RastPort=RastPort(Min(PrefDisplayBuffering-1,1+cnt))
ClipBlit_ *RP1,0,0,*RP0,0,0,PrefDisplayWidth,PrefDisplayHeight,$C0
If PrefDisplayBuffering=3 Then cnt=1-cnt ; Toggle output buffer
EndIf
;**** necessary ****
If #UnQ Then MUnQueue 0,1
MFlushQueue 0
its+1
Wend
;Report
t=Timer
t=Max(t,1)
its=Max(its,1)
a.q=50.0/(t/its)
WBenchToFront_
FindScreen 1
Window 2,16,16,300,40,0,"Test results",1,0
WindowOutput 2
NPrint a," frames per second"
NPrint " "
NPrint "Press mouse/joy button..."
Repeat
Until Joyb(0)<>0 OR Joyb(1)<>0
Finish:
End